(define (uann:make-annotated-program mw-prog mc)
  (define (annotate-fndef* fndef* mc)
    (if (null? fndef*)
      '(())
      (let ((rest (cdr fndef*)) (fndef (car fndef*)))
        (let ((%%24 (annotate-fndef fndef mc))
              (%%25 (annotate-fndef* rest mc)))
          (let ((s-rest (cdr %%25))
                (d-rest (car %%25))
                (ind (cdr %%24))
                (ann-fndef (car %%24)))
            (if (eq? ind 's)
              `(,d-rest ,ann-fndef unquote s-rest)
              `((,ann-fndef unquote d-rest) unquote s-rest)))))))
  (define (annotate-fndef fndef mc)
    (let ((fbody (cadddr fndef))
          (fpars (cadr fndef))
          (fn (car fndef)))
      (let ((%%26 (lookup-function-description fn mc)))
        (let ((fres (cdr %%26)) (fargs (car %%26)))
          (if (eq? fres 's)
            `(,fndef . s)
            (let ((%%27 (sep-sd fpars fargs)))
              (let ((d-fpars (cdr %%27)) (s-fpars (car %%27)))
                (let ((%%28 (annotate-exp fbody fpars fargs mc)))
                  (let ((ind (cdr %%28)) (ann-fbody (car %%28)))
                    `((,fn
                       ,s-fpars
                       ,d-fpars
                       =
                       ,(protect-static-exp ann-fbody ind))
                      .
                      d))))))))))
  (define (annotate-exp exp vn vv mc)
    (cond ((symbol? exp)
           `(,exp unquote (lookup-variable exp vn vv)))
          ((equal? (car exp) 'quote)
           (let ((s-exp (cadr exp))) `(,exp . s)))
          ((equal? (car exp) 'generalize)
           (let ((exp1 (cadr exp)))
             (let ((%%29 (annotate-exp exp1 vn vv mc)))
               (let ((ind1 (cdr %%29)) (ann-exp1 (car %%29)))
                 `(,(protect-static-exp ann-exp1 ind1) . d)))))
          ((equal? (car exp) 'if)
           (let ((exp3 (cadddr exp))
                 (exp2 (caddr exp))
                 (exp1 (cadr exp)))
             (let ((%%30 (annotate-exp exp1 vn vv mc)))
               (let ((ind1 (cdr %%30)) (aexp1 (car %%30)))
                 (let ((%%31 (annotate-exp exp2 vn vv mc)))
                   (let ((ind2 (cdr %%31)) (aexp2 (car %%31)))
                     (let ((%%32 (annotate-exp exp3 vn vv mc)))
                       (let ((ind3 (cdr %%32)) (aexp3 (car %%32)))
                         (let ((%%33 (lub ind1 (lub ind2 ind3))))
                           (let ((ind %%33))
                             (if (eq? ind 's)
                               `(,exp . s)
                               (let ((aif (if (eq? ind1 's) 'ifs 'ifd))
                                     (aexp2 (protect-static-exp aexp2 ind2))
                                     (aexp3 (protect-static-exp aexp3 ind3)))
                                 `((,aif ,aexp1 ,aexp2 ,aexp3) . d)))))))))))))
          ((let ((call? (car exp)))
             (memq call? '(call rcall)))
           (let ((call? (car exp)))
             (let ((exp* (cddr exp)) (fn (cadr exp)))
               (let ((%%34 (lookup-function-description fn mc)))
                 (let ((fres (cdr %%34)) (fargs (car %%34)))
                   (if (eq? fres 's)
                     `(,exp . s)
                     (let ((%%35 (sep-sd exp* fargs)))
                       (let ((d-exp* (cdr %%35)) (s-exp* (car %%35)))
                         (let ((%%36 (annotate-exp* d-exp* vn vv mc)))
                           (let ((ind* (cdr %%36)) (ann-d-exp* (car %%36)))
                             `((,call?
                                ,fn
                                ,s-exp*
                                ,(protect-static-exp* ann-d-exp* ind*))
                               .
                               d)))))))))))
          ((equal? (car exp) 'xcall)
           (let ((exp* (cddr exp)) (fname (cadr exp)))
             (let ((%%37 (annotate-exp* exp* vn vv mc)))
               (let ((ind* (cdr %%37)) (ann-exp* (car %%37)))
                 (let ((%%38 (lub-list ind*)))
                   (let ((ind %%38))
                     (if (eq? ind 's)
                       `(,exp . s)
                       `((xcall ,fname
                                unquote
                                (protect-static-exp* ann-exp* ind*))
                         .
                         d))))))))
          (else
           (let ((exp* (cdr exp)) (op (car exp)))
             (let ((%%39 (annotate-exp* exp* vn vv mc)))
               (let ((ind* (cdr %%39)) (ann-exp* (car %%39)))
                 (let ((%%40 (lub-list ind*)))
                   (let ((ind %%40))
                     (if (eq? ind 's)
                       `(,exp . s)
                       `((,op unquote (protect-static-exp* ann-exp* ind*))
                         .
                         d))))))))))
  (define (annotate-exp* exp* vn vv mc)
    (let ((res-ind*
            (map (lambda (exp) (annotate-exp exp vn vv mc))
                 exp*)))
      `(,(map car res-ind*) unquote (map cdr res-ind*))))
  (define (protect-static-exp exp ind)
    (cond ((eq? ind 'd) exp)
          ((and (pair? exp) (equal? (car exp) 'error))
           (let ((exp* (cdr exp)))
             `(error unquote
                     (map (lambda (e) (protect-static-exp e 's)) exp*))))
          (else `(static ,exp))))
  (define (protect-static-exp* exp* ind*)
    (if (and (null? exp*) (null? ind*))
      '()
      (let ((rest-ind* (cdr ind*))
            (ind (car ind*))
            (rest-exp* (cdr exp*))
            (exp (car exp*)))
        (cons (protect-static-exp exp ind)
              (protect-static-exp* rest-exp* rest-ind*)))))
  (define (sep-sd lst ind*)
    (if (and (null? lst) (null? ind*))
      '(())
      (let ((r-ind* (cdr ind*))
            (ind (car ind*))
            (r-lst (cdr lst))
            (first (car lst)))
        (let ((%%41 (sep-sd r-lst r-ind*)))
          (let ((d-lst (cdr %%41)) (s-lst (car %%41)))
            (case ind
              ((s) `((,first unquote s-lst) unquote d-lst))
              ((d) `(,s-lst ,first unquote d-lst))))))))
  (define (lub ind1 ind2)
    (if (eq? ind1 'd) 'd ind2))
  (define (lub-list ind*)
    (if (memq 'd ind*) 'd 's))
  (define (lookup-function-description fname mc)
    (cdr (assq fname mc)))
  (define (lookup-variable vname vn* vv*)
    (if (and (null? vn*) (null? vv*))
      (error "Undefined variable: " vname)
      (let ((vrest (cdr vv*))
            (vv (car vv*))
            (nrest (cdr vn*))
            (vn (car vn*)))
        (if (eq? vname vn)
          vv
          (lookup-variable vname nrest vrest)))))
  (let ((%%42 (annotate-fndef* mw-prog mc)))
    (let ((s-fndef* (cdr %%42)) (d-fndef* (car %%42)))
      (let ((%%43 (uresfn:collect-residual-functions d-fndef*)))
        (let ((rf-names %%43))
          `(,rf-names ,d-fndef* ,s-fndef*))))))

